home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / ClockElems.Mod (.txt) < prev    next >
Oberon Text  |  1995-06-10  |  7KB  |  195 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. (* Notify Ralf for maintenance of Non-FPU source *)
  4. MODULE ClockElems; (* gri 18.3.91 *)    (* mod CAS 8-Jul-91 *)
  5.     IMPORT Texts, TextFrames, TextPrinter, Math, Oberon, Display, Printer, Viewers, Files, Input;
  6.     CONST
  7.         Rmin = 12; Rdef = 32; (* clock radi in pixels *)
  8.     TYPE
  9.         Time = RECORD sec, min, hour: INTEGER; timeStamp: LONGINT END;
  10.         Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
  11.         NotifyMsg = RECORD(Display.FrameMsg) END;
  12.         sin, cos: ARRAY 60 OF REAL;
  13.         wakeUp: LONGINT; (* overflow in 82.8 days *)
  14.         old, new: Time;
  15.         Task: Oberon.Task;
  16.         Line: PROCEDURE(x1, y1, x2, y2, color, mode: INTEGER); (* current output procedure *)
  17.         Circle: PROCEDURE(x0, y0, r, color, mode: INTEGER); (* current output procedure *)
  18. (* initialization *)
  19.     PROCEDURE Init;
  20.         VAR i: INTEGER;
  21.     BEGIN i := 0;
  22.         WHILE i < 60 DO
  23.             sin[i] := Math.sin(2 * Math.pi / 60 * i);
  24.             cos[i] := Math.cos(2 * Math.pi / 60 * i);
  25.             INC(i)
  26.         END
  27.     END Init;
  28.     PROCEDURE GetTime(VAR time: Time);
  29.         VAR t, d: LONGINT;
  30.     BEGIN
  31.         Oberon.GetClock(t, d);
  32.         time.sec := SHORT(t MOD 64);
  33.         time.min := SHORT(t DIV 64 MOD 64);
  34.         time.hour := SHORT(t DIV (64*64))*5 + time.min DIV 12;
  35.         time.timeStamp := t
  36.     END GetTime;
  37. (* graphics *)
  38.     PROCEDURE* SCircle(x0, y0, r, color, mode: INTEGER);
  39.         VAR x, y, dx, dy, d: INTEGER;
  40.         PROCEDURE Dot4(x1, x2, y1, y2, color, mode: INTEGER);
  41.         BEGIN
  42.             Display.Dot(color, x1, y1, mode);
  43.             Display.Dot(color, x1, y2, mode);
  44.             Display.Dot(color, x2, y1, mode);
  45.             Display.Dot(color, x2, y2, mode)
  46.         END Dot4;
  47.     BEGIN
  48.         x := r; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1-4*r;
  49.         WHILE x > y DO
  50.             Dot4(x0-x, x0+x, y0-y, y0+y, color, mode);
  51.             Dot4(x0-y, x0+y, y0-x, y0+x, color, mode);
  52.             INC(d, dy); INC(dy, 8); INC(y);
  53.             IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  54.         END;
  55.         IF x = y THEN Dot4(x0-x, x0+x, y0-y, y0+y, color, mode) END
  56.     END SCircle;
  57.     PROCEDURE* SLine(x1, y1, x2, y2, color, mode: INTEGER);
  58.         VAR x, y, dx, dy, d, inc: INTEGER;
  59.     BEGIN
  60.         IF (y2-y1) < (x1-x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  61.         dx := 2*(x2-x1);
  62.         dy := 2*(y2-y1);
  63.         x := x1; y := y1; inc := 1;
  64.         IF dy > dx THEN
  65.             d := dy DIV 2;
  66.             IF dx < 0 THEN inc := -1; dx := -dx END;
  67.             WHILE y <= y2 DO
  68.                 Display.Dot(color, x, y, mode);
  69.                 INC(y); DEC(d, dx);
  70.                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  71.             END
  72.         ELSE
  73.             d := dx DIV 2;
  74.             IF dy < 0 THEN inc := -1; dy := -dy END;
  75.             WHILE x <= x2 DO
  76.                 Display.Dot(color, x, y, mode);
  77.                 INC(x); DEC(d, dy);
  78.                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  79.             END
  80.         END
  81.     END SLine;
  82.     PROCEDURE* PCircle(x0, y0, r, color, mode: INTEGER);
  83.     BEGIN Printer.Circle(x0, y0, r)
  84.     END PCircle;
  85.     PROCEDURE* PLine(x1, y1, x2, y2, color, mode: INTEGER);
  86.     BEGIN Printer.Line(x1, y1, x2, y2)
  87.     END PLine;
  88. (* view update *)
  89.     PROCEDURE Line2(ang: INTEGER; x0, y0, r1, r2, color: INTEGER);
  90.         VAR x1, y1, x2, y2: INTEGER;
  91.     BEGIN
  92.         ang := (15-ang) MOD 60;
  93.         x1 := SHORT(ENTIER(r1*cos[ang] + 0.5));
  94.         y1 := SHORT(ENTIER(r1*sin[ang] + 0.5));
  95.         x2 := SHORT(ENTIER(r2*cos[ang] + 0.5));
  96.         y2 := SHORT(ENTIER(r2*sin[ang] + 0.5));
  97.         Line(x0+x1, y0+y1, x0+x2, y0+y2, color, Display.invert)
  98.     END Line2;
  99.     PROCEDURE Draw(VAR time: Time; x0, y0, r, color: INTEGER);
  100.         VAR rh, rm, rs, i: INTEGER;
  101.     BEGIN
  102.         IF r >= Rmin THEN
  103.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11; i := 0;
  104.             WHILE i < 60 DO Line2(i, x0, y0, rm, r, color); INC(i, 5) END;
  105.             Line2(time.sec, x0, y0, rm-r, rs, color);
  106.             Line2(time.min, x0, y0, 0, rm, color);
  107.             Line2(time.hour, x0, y0, 0, rh, color);
  108.             Circle(x0, y0, 2, color, Display.replace)
  109.         END;
  110.         Circle(x0, y0, r, color, Display.replace)
  111.     END Draw;
  112.     PROCEDURE Update(VAR old, new: Time; x0, y0, r, color: INTEGER);
  113.         VAR rh, rm, rs: INTEGER;
  114.     BEGIN
  115.         IF r >= Rmin THEN
  116.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11;
  117.             IF old.sec # new.sec THEN Line2(old.sec, x0, y0, rm-r, rs, color); Line2(new.sec, x0, y0, rm-r, rs, color) END;
  118.             IF old.min # new.min THEN Line2(old.min, x0, y0, 0, rm, color); Line2(new.min, x0, y0, 0, rm, color) END;
  119.             IF old.hour # new.hour THEN Line2(old.hour, x0, y0, 0, rh, color); Line2(new.hour, x0, y0, 0, rh, color) END;
  120.         END
  121.     END Update;
  122. (* methods *)
  123.     PROCEDURE* HandleFrame(F: Display.Frame; VAR M: Display.FrameMsg);
  124.         VAR r: INTEGER;
  125.     BEGIN
  126.         IF M IS NotifyMsg THEN Line := SLine; Circle := SCircle; r := F.W DIV 2;
  127.             Update(old, new, F.X+r, F.Y+r, r, F(Frame).col)
  128.         ELSIF M IS Oberon.InputMsg THEN
  129.             WITH M: Oberon.InputMsg DO
  130.                 IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
  131.             END
  132.         END
  133.     END HandleFrame;
  134.     PROCEDURE* HandleElem(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  135.         VAR e: Texts.Elem; f: Frame; r: INTEGER; ch: CHAR;
  136.     BEGIN
  137.         IF msg IS TextFrames.DisplayMsg THEN
  138.             WITH msg: TextFrames.DisplayMsg DO
  139.                 IF ~msg.prepare THEN
  140.                     Line := SLine; Circle := SCircle; r := SHORT((E.W DIV TextFrames.Unit - 1) DIV 2);
  141.                     Draw(new, msg.X0+r, msg.Y0+r, r, msg.col);
  142.                     NEW(f); f.X := msg.X0; f.Y := msg.Y0; f.W := 2*r + 1; f.H := f.W;
  143.                     f.handle := HandleFrame; f.col := msg.col;
  144.                     msg.elemFrame := f
  145.                 END
  146.             END
  147.         ELSIF msg IS TextPrinter.PrintMsg THEN
  148.             WITH msg: TextPrinter.PrintMsg DO
  149.                 IF ~msg.prepare THEN
  150.                     Line := PLine; Circle := PCircle; r := SHORT((E.W DIV TextPrinter.Unit - 1) DIV 2);
  151.                     Draw(new, msg.X0+r, msg.Y0+r, r, msg.col)
  152.                 END
  153.             END
  154.         ELSIF msg IS Texts.CopyMsg THEN
  155.             NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
  156.         ELSIF msg IS Texts.IdentifyMsg THEN
  157.             WITH msg: Texts.IdentifyMsg DO
  158.                 msg.mod := "ClockElems"; msg.proc := "New"
  159.             END
  160.         ELSIF msg IS Texts.FileMsg THEN
  161.             WITH msg: Texts.FileMsg DO
  162.                 IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
  163.                 ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
  164.                 END
  165.             END
  166.         END
  167.     END HandleElem;
  168.     PROCEDURE* Clock;
  169.         VAR msg: NotifyMsg;
  170.     BEGIN
  171.         old := new; GetTime(new);
  172.         IF old.timeStamp # new.timeStamp THEN Task.time := Input.Time()+Input.TimeUnit;
  173.             Viewers.Broadcast(msg)
  174.         ELSE Task.time := Input.Time() + 10 (* synchronization *)
  175.         END
  176.     END Clock;
  177. (* commands *)
  178.     PROCEDURE New*;
  179.     BEGIN NEW(Texts.new); Texts.new.handle := HandleElem
  180.     END New;
  181.     PROCEDURE Insert*;
  182.         VAR S: Texts.Scanner; w: LONGINT; E: Texts.Elem; M: TextFrames.InsertElemMsg;
  183.     BEGIN
  184.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  185.         IF (S.line = 0) & (S.class = Texts.Int) & (S.i > 0) THEN w := (2*S.i+1)*Display.Unit
  186.         ELSE w := (2*Rdef+1)*Display.Unit
  187.         END;
  188.         NEW(E); E.W := w; E.H := w; E.handle := HandleElem;
  189.         M.e := E; Viewers.Broadcast(M)
  190.     END Insert;
  191. BEGIN
  192.     Init; wakeUp := 0; GetTime(new);
  193.     NEW(Task); Task.safe := TRUE; Task.time := 0; Task.handle := Clock; Oberon.Install(Task)
  194. END ClockElems.
  195.